home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 00 / 5 / DISK0059.ZIP / PSCREEN.BAS < prev    next >
BASIC Source File  |  1983-05-31  |  13KB  |  328 lines
  1. 5 WIDTH "SCRN:",80
  2. 10 'LPRINT CHR$(27)"@";
  3. 20 'LPRINT CHR$(27)"2";
  4. 30 E$=CHR$(27)
  5. 40 ONN$(2)=E$+CHR$(87)+CHR$(1) : OFFF$(2)=E$+CHR$(87)+CHR$(0)
  6. 50 ONN$(3)=E$+CHR$(69)         : OFFF$(3)=E$+CHR$(70)
  7. 60 ONN$(4)=E$+CHR$(52)         : OFFF$(4)=E$+CHR$(53)
  8. 70 ONN$(5)=E$+CHR$(48)         : OFFF$(5)=E$+CHR$(50)
  9. 80 ONN$(6)=E$+CHR$(70)+CHR$(15): OFFF$(6)=CHR$(18)
  10. 90 ONN$(7)=E$+CHR$(71)         : OFFF$(7)=E$+CHR$(72)
  11. 100 ONN$(8)=E$+CHR$(45)+CHR$(1): OFFF$(8)=E$+CHR$(45)+CHR$(0)
  12. 110 INPUT "Set the printer to the top of the page. ";C$
  13. 115 IF C$ = "s"  THEN STD = 1 ELSE STD = 0
  14. 116 INPUT "What is the control character indicator?";Q$
  15. 118 LENGTH = 66
  16. 120 IF STD=0 THEN INPUT "How many lines per page";LENGTH
  17. 121 IF LENGTH = 0 THEN LENGTH = 66
  18. 125 LINE.LENGTH = 70
  19. 130 IF STD=0 THEN INPUT "what`s the line length";LINE.LENGTH
  20. 135 IF LINE.LENGTH = 0 THEN LINE.LENGTH = 70
  21. 170 PAGE = 1:  SECTION.C$ = " ": ZZ$="a"
  22. 180 INPUT "Do you want lettered sections (Y or N)";SECT$
  23. 190 IF NOT(SECT$="Y" OR SECT$="y") THEN SECT$="-": GOTO 240
  24. 200 INPUT "What letter should I start with?  (1=`A' 2=`B' etc.)";S.N
  25. 205 IF S.N =0 THEN S.N = 1
  26. 210 SECTION.N = 64+S.N
  27. 220 SECTION.C$ = CHR$(SECTION.N)
  28. 230 SECT$ = " "
  29. 240 'LPRINT CHR$(27)"O";
  30. 250 'LPRINT CHR$(27)"C"CHR$(1)CHR$(LENGTH);
  31. 255 T.START = 6: T.END = 59: M.L = 8
  32. 260 IF STD = 0 THEN INPUT "On which line does the text begin";T.START
  33. 265 IF T.START = 0 THEN T.START = 6
  34. 270 IF STD = 0 THEN INPUT "On which line does it end        ";T.END
  35. 275 IF T.END = 0 THEN T.END = 59
  36. 280 PITCH = 10
  37. 281 IF NOT STD = 0 THEN GOTO 290
  38. 282 INPUT "How many columns for left margin (d=8)";M$
  39. 283 IF M$="" THEN M.L = 8 ELSE M.L = VAL(M$)
  40. 285 IF NOT ((LINE.LENGTH + M.L) > 78) THEN GOTO 290
  41. 286 LINE.LENGTH = LINE.LENGTH - 1
  42. 287 GOTO 285
  43. 290 PARA.INDENT = 5: CC.ON.BUF = 0
  44. 300 TLINES = T.END - T.START + 1
  45. 310 MARG.BOT = LENGTH - T.END
  46. 320 LYNE = 1
  47. 330 FOR I=0 TO 8: FLAG(I)=0: NEXT I
  48. 340 MARG.TOP = T.START - 1
  49. 350 FOR I=1 TO MARG.TOP
  50. 360 LYNE = LYNE + 1 :PRINT
  51. 370 NEXT I
  52. 380 MODE = 1: TEXT.COUNT = 0: BUFFER$ = "": LAST.TEXT$ = " "
  53. 385 T.IN.LINE = 0: L.ON = 1: PAGE.LINE = 63
  54. 390 IF STD=0 THEN INPUT "On which line do you want the page numbers";PAGE.LINE
  55. 400 INPUT "What is the name of your file"; FILE$
  56. 410 '
  57. 420 OPEN FILE$ FOR INPUT  AS #1
  58. 430 '
  59. 440 '
  60. 450 'LPRINT CHR$(27)"@";
  61. 460 ' SUBROUTINE NEW-LINE
  62. 470 '
  63. 480 IF EOF(1) THEN GOSUB 1360: CLOSE:END
  64. 490 CC.CODE = 1
  65. 500 LINE INPUT  #1,C$
  66. 510 LEN.C = LEN(C$)
  67. 520 IF NOT (LEN.C=0) THEN GOTO 550
  68. 530 IF FLAG (0) = 1 THEN GOSUB 1360
  69. 540 GOTO 460
  70. 550 LASTC$=RIGHT$(C$,1)
  71. 560 IF LASTC$ = " " THEN C$=LEFT$(C$,LEN.C-1): GOTO 510
  72. 570 FIRSTC$=LEFT$(C$,1)
  73. 580 IF (FLAG(0)=1) OR (NOT(FIRSTC$=" ")) THEN GOTO 620
  74. 590 LEN.C = LEN(C$)
  75. 600 C$ = RIGHT$(C$,LEN.C -1)
  76. 610 IF LEN.C =1 THEN GOTO 460 ELSE GOTO 570
  77. 620 IF FIRSTC$=Q$ THEN GOSUB 670 ELSE  GOSUB 760
  78. 630 IF NOT(LEN(C$) = 0) THEN GOTO 570
  79. 640 IF FLAG(0) = 1 THEN GOSUB 1360
  80. 650 GOTO 460
  81. 660 '
  82. 670 ' Subroutine control character
  83. 680 '
  84. 690 L.LEN = LEN(C$)
  85. 700 CC.CHAR$=MID$(C$,2,1)
  86. 705 IF CC.CHAR$=" " THEN GOTO 742
  87. 710 L.LEN = L.LEN -2
  88. 720 IF L.LEN>0 THEN C$=RIGHT$(C$,L.LEN) ELSE C$="" '  removes control character
  89. 730  GOSUB 1810  ' send control char to buffer
  90. 740 RETURN
  91. 741 '  here is a literal Q$. keep it as text.
  92. 742 E.MARK$ = LEFT$(C$,2)
  93. 743 BUFFER$=BUFFER$ + E.MARK$
  94. 744 TEXT.COUNT = TEXT.COUNT + 2
  95. 745 L.LEN = L.LEN - 2
  96. 746 IF L.LEN>0 THEN C$=RIGHT$(C$,L.LEN) ELSE C$="" '  removes control character
  97. 747 RETURN
  98. 750 '
  99. 760 ' Subroutine accumulate good text from line
  100. 770 '
  101. 780 L.LEN = LEN (C$)
  102. 790 FOR I=1 TO L.LEN
  103. 800 IF MID$(C$,I,1) = Q$ THEN GOTO 870
  104. 810 NEXT I
  105. 820 TEXT$=C$
  106. 830 IF FLAG(1) = 1 THEN C$ = "":  RETURN '  if this is a centering line...
  107. 840 GOSUB 950' send text to buffer
  108. 850 C$=""
  109. 860 RETURN
  110. 870 ' (there's a cc.char in the string...)
  111. 880 TEXT$=LEFT$(C$,I-1)
  112. 890 L.LEN = L.LEN -I+1
  113. 900 C$=RIGHT$(C$,L.LEN)
  114. 910 IF FLAG(1) = 1 THEN RETURN
  115. 920 GOSUB 950'  send text to buffer
  116. 930 RETURN
  117. 940 '
  118. 950 'Subroutine text buffer
  119. 960 '
  120. 970 IF (TEXT.COUNT + (LEN(TEXT$)*PITCH/10) > LINE.LENGTH - 1) THEN GOTO 1070
  121. 980 TEXT.COUNT = TEXT.COUNT + (LEN(TEXT$)*PITCH/10)' add text to buffer
  122. 990 IF (LAST.TEXT$ = " " AND LEFT$(TEXT$,1) = " " AND FLAG(0)=0) THEN                   TEXT$ = RIGHT$(TEXT$,LEN(TEXT$) -1): ELSE GOTO 1010
  123. 1000 GOTO 990
  124. 1010 IF NOT (LAST.TEXT$ = " " OR LEFT$(TEXT$,1) = " ") THEN                        BUFFER$=BUFFER$ + SPACE$(1): TEXT.COUNT = TEXT.COUNT + PITCH/10
  125. 1020 BUFFER$=BUFFER$+TEXT$: T.IN.LINE = 1
  126. 1030 LAST.TEXT$= RIGHT$(BUFFER$,1)
  127. 1040 TEXT$ = ""
  128. 1050 RETURN' buffer isn't full yet.
  129. 1060 '
  130. 1070 GOSUB 1180 'find the max amount of text that fits
  131. 1080 IF NOT(LAST.TEXT$=" " OR LEFT$(MAX.TEXT$,1) = " ") THEN                            BUFFER$=BUFFER$ + SPACE$(1)
  132. 1090 BUFFER$=BUFFER$ + MAX.TEXT$: T.IN.LINE =1'--fill the buffer with amap
  133. 1100 LAST.TEXT$ = RIGHT$(BUFFER$,1)
  134. 1110 GOSUB 1360: L.ON = 0
  135. 1120 IF NOT(LYNE > T.END) THEN GOTO 1140
  136. 1130 GOSUB 1570: GOSUB 1710
  137. 1140 IF LEN(TEXT$) >0 THEN GOTO 970
  138. 1150 RETURN
  139. 1160 ' end text buffer
  140. 1170 '
  141. 1180 'Subroutine find the max amount of text that fits
  142. 1200 SPACE = LINE.LENGTH - TEXT.COUNT'-- this is the space available at EOL
  143. 1210 SPACE = SPACE * PITCH/10
  144. 1215 IF FLAG(0) = 1 THEN GOTO 1280
  145. 1220 FOR I=SPACE TO 1 STEP -1'   ----------\
  146. 1230 M$=MID$(TEXT$,I,1)
  147. 1240 IF M$=" " OR M$= "-" THEN GOTO 1320'  >- find a blank in the string
  148. 1250 NEXT I' ------------------------------/
  149. 1260 MAX.TEXT$= ""
  150. 1270 IF FLAG(0)=0 THEN RETURN
  151. 1280  MAX.TEXT$=TEXT$
  152. 1290 PRINT "pre-formatted line is too long." TEXT$
  153. 1300 INPUT "continue";Z$
  154. 1310 TEXT$ = "": RETURN
  155. 1320 MAX.TEXT$=LEFT$(TEXT$,I)'---this is as much as can be added to buffer
  156. 1330 TEXT$=RIGHT$(TEXT$,LEN(TEXT$)-I)'--this is what's left.
  157. 1340 RETURN
  158. 1350 '
  159. 1360 ' Subroutine print buffer and initialize it again
  160. 1370 '
  161. 1380 IF (FLAG(1)=1 OR FLAG(0)=1) THEN BLANKS =M.L ELSE BLANKS = INDENT +M.L
  162. 1400 PRINT SPACE$(BLANKS); BUFFER$
  163. 1410 BUFFER$="": CC.ON.BUF = 0: T.IN.LINE = 0
  164. 1420 LAST.TEXT$ = " ": CENTER = 0
  165. 1430 IF FLAG(1)=1 OR FLAG(0)=1 THEN TEXT.COUNT = 0 ELSE TEXT.COUNT = INDENT
  166. 1440 LYNE = LYNE + 1
  167. 1450 IF NOT(LYNE > T.END) THEN RETURN
  168. 1460 IF P.END = 1 THEN P.END =0: RETURN   ELSE GOSUB 1570: GOSUB 1710
  169. 1470 RETURN
  170. 1480 '
  171. 1490 '
  172. 1500 'Subroutine stick control character on buffer
  173. 1510 '
  174. 1520 'IF FLAG(CODE.NUMBER)=1 THEN BUFFER$=BUFFER$ + ONN$(CODE.NUMBER)                    ELSE BUFFER$ = BUFFER$ + OFFF$(CODE.NUMBER)
  175. 1530 CC.ON.BUF = CC.ON.BUF + 3
  176. 1540 RETURN
  177. 1550 '
  178. 1560 '
  179. 1570 'Subroutine go to the top of the next page
  180. 1580 '
  181. 1590 IF LYNE > T.END THEN GOTO  1640' take care of new page
  182. 1600 TOSKIP = T.END - LYNE
  183. 1610 FOR I=1 TO TOSKIP : PRINT
  184. 1620 LYNE = LYNE + 1
  185. 1630 NEXT I
  186. 1640 FOR I = 1 TO MARG.BOT
  187. 1650 IF LYNE = PAGE.LINE THEN GOSUB 2870 ELSE PRINT : LYNE=LYNE+1
  188. 1660 NEXT I
  189. 1670 PAGE = PAGE + 1
  190. 1680 RETURN
  191. 1690 '
  192. 1700 '
  193. 1710 ' subroutine top of new page
  194. 1720 IF NOT (ZZ$="") THEN INPUT "new page. ready?";ZZ$
  195. 1730 LYNE = 1
  196. 1740 FOR I = 1 TO MARG.TOP
  197. 1750 IF I= PAGE.LINE THEN GOSUB 2870 ELSE PRINT :LYNE=LYNE+1
  198. 1760 NEXT I
  199. 1770 RETURN
  200. 1780 'END  (newpage)
  201. 1790 '
  202. 1800 '
  203. 1810 'Subroutine special code mode
  204. 1820 '
  205. 1830 IF NOT(CC.CHAR$= "*") THEN GOTO 1870
  206. 1840 IF TEXT.COUNT > 0 THEN GOSUB 1360
  207. 1850 IF FLAG(0) = 1 THEN FLAG(0) = 0:L.ON =1: ELSE FLAG(0) = 1: L.ON = 0
  208. 1860  RETURN
  209. 1870 V = VAL (CC.CHAR$)
  210. 1880 IF CC.CHAR$ = "0" THEN GOTO 1900
  211. 1890 IF NOT (0 < V  AND V < 7) THEN GOTO 1930' \___ handle indentation
  212. 1900 IF TEXT.COUNT > 0 THEN GOSUB 1360: L.ON = 1
  213. 1910 INDENT = 5 * VAL(CC.CHAR$)
  214. 1920 TEXT.COUNT = INDENT  : RETURN
  215. 1930 IF NOT(CC.CHAR$ = "p" OR CC.CHAR$ = "P") THEN GOTO 1990
  216. 1940 IF T.IN.LINE = 1 THEN GOSUB 1360 :L.ON=0 :ELSE GOTO 1970
  217. 1950    BUFFER$ = BUFFER$ + SPACE$(PARA.INDENT)
  218. 1960    TEXT.COUNT = PARA.INDENT+ TEXT.COUNT: RETURN
  219. 1970 'IF L.ON = 1  THEN GOSUB 1360
  220. 1980 'L.ON = 1: GOTO 1950
  221. 1985 GOTO 1950
  222. 1990 IF NOT(CC.CHAR$ = "L" OR CC.CHAR$="l") THEN GOTO 2020
  223. 2000 IF T.IN.LINE = 1 OR L.ON = 1 THEN GOSUB 1360
  224. 2010 L.ON = 1 : RETURN
  225. 2020 IF NOT (CC.CHAR$="!") THEN GOTO 2060
  226. 2030 IF TEXT.COUNT > INDENT THEN GOSUB 1360
  227. 2040 GOSUB 1570: GOSUB 1710
  228. 2050 L.ON = 1: RETURN
  229. 2060 IF NOT (CC.CHAR$="?") THEN GOTO 2100
  230. 2070 LINES.LEFT = T.END-LYNE
  231. 2080 IF LINES.LEFT < TLINES/2 THEN RETURN ELSE GOTO 2030
  232. 2090 RETURN
  233. 2100 IF NOT (CC.CHAR$="C" OR CC.CHAR$="c") THEN GOTO 2120 ELSE GOSUB 2270
  234. 2110  RETURN 'special code mode
  235. 2120 IF NOT (CC.CHAR$="$") THEN GOSUB 2460 ELSE GOSUB 2160
  236. 2130 RETURN
  237. 2140 '
  238. 2150 '
  239. 2160 'Subroutine next section
  240. 2170 '
  241. 2180 IF SECT$= "-" THEN RETURN
  242. 2190 GOSUB 1570
  243. 2200 PAGE = 1
  244. 2210 SECTION.N = SECTION.N + 1
  245. 2220 SECTION.C$ = CHR$(SECTION.N)
  246. 2230 GOSUB 1710
  247. 2240 RETURN
  248. 2250 '
  249. 2260 '
  250. 2270 ' Subroutine center the line
  251. 2280 '
  252. 2290 COLS = PITCH * (LINE.LENGTH/10)
  253. 2300 IF T.IN.LINE > 0 THEN GOSUB 1360: L.ON =0'-- print the buffer
  254. 2305 IF CENTER = 1 THEN GOTO 2310
  255. 2310 TEXT.COUNT = 0
  256. 2320 FLAG(1) = 1
  257. 2330 GOSUB 760'---get text up to next Q$
  258. 2340 IF LEN(TEXT$) > LINE.LENGTH  THEN GOSUB 1180                                            ELSE MAX.TEXT$ = TEXT$ : TEXT$ = ""
  259. 2350 TOSKIP = (COLS -LEN(MAX.TEXT$))/2 '  compute leading blanks
  260. 2360 BUFFER$ = BUFFER$ + SPACE$(TOSKIP) '  add the blanks to buffer
  261. 2370 BUFFER$ = BUFFER$ + MAX.TEXT$: T.IN.LINE = 1'---add text to buffer
  262. 2380 LAST.TEXT$ = " "
  263. 2390 GOSUB 1360'-- print the line
  264. 2400 IF LEN(TEXT$)>0 THEN GOTO 2340
  265. 2410 FLAG(1) =0 : L.ON = 1: CENTER = 1
  266. 2420 RETURN
  267. 2430 END' (SUBROUTINE SPECIAL CODE MODE)
  268. 2440 '
  269. 2450 '
  270. 2460 'Subroutine decode cc.char and send codes to buffer
  271. 2470 '
  272. 2480 IF NOT(CC.CHAR$="@") THEN GOTO 2530
  273. 2490 FOR I = 2 TO 8
  274. 2500    FLAG(I) = 0' BUFFER$ = BUFFER$ + OFFF$(I)
  275. 2510    NEXT I
  276. 2520    GOTO 2810
  277. 2530 IF NOT (CC.CHAR$="E" OR CC.CHAR$="e") THEN GOTO 2560                                 ELSE IF (CC.CHAR$="E") THEN FLAG(3) = 1  ELSE FLAG(3) = 0
  278. 2540 CODE.NUMBER = 3:  GOSUB 1490'  get buffer fixed
  279. 2550                            GOTO 2810
  280. 2560 IF NOT (CC.CHAR$="D" OR CC.CHAR$="d") THEN GOTO 2590                                ELSE IF (CC.CHAR$="D") THEN FLAG(2) = 1  ELSE FLAG(2) = 0
  281. 2570 CODE.NUMBER = 2: GOSUB 1490'  get buffer fixed
  282. 2580                            GOTO 2810
  283. 2590 IF NOT (CC.CHAR$="I" OR CC.CHAR$="i") THEN GOTO 2620                                ELSE IF (CC.CHAR$="I") THEN FLAG(4) = 1  ELSE FLAG(4) = 0
  284. 2600 CODE.NUMBER = 4: GOSUB 1490'  get buffer fixed
  285. 2610                            GOTO 2810
  286. 2620 IF NOT (CC.CHAR$="N" OR CC.CHAR$="n") THEN GOTO 2650                                ELSE IF (CC.CHAR$="N") THEN FLAG(5) = 1   ELSE FLAG(5) = 0
  287. 2630 CODE.NUMBER = 5: GOSUB 1490' get buffer fixed
  288. 2640                            GOTO 2810
  289. 2650 IF NOT (CC.CHAR$="T" OR CC.CHAR$="t") THEN GOTO 2680                                ELSE IF (CC.CHAR$="T") THEN FLAG(7) = 1 ELSE FLAG(7) = 0
  290. 2660 CODE.NUMBER = 7: GOSUB 1490' get buffer fixed
  291. 2670                            GOTO 2810
  292. 2680 IF NOT (CC.CHAR$="U" OR CC.CHAR$="u") THEN GOTO 2710                                ELSE IF (CC.CHAR$="U") THEN FLAG(8) = 1 ELSE FLAG(8) = 0
  293. 2690 CODE.NUMBER = 8: GOSUB 1490' get buffer fixed
  294. 2700                            GOTO 2810
  295. 2710 IF NOT (CC.CHAR$="S" OR CC.CHAR$="s") THEN GOTO 2740                                ELSE IF (CC.CHAR$="S") THEN FLAG(6) = 1 ELSE FLAG(6) = 0
  296. 2720 CODE.NUMBER = 6: GOSUB 1490' get buffer fixed
  297. 2730                            GOTO 2810
  298. 2740 IF NOT (CC.CHAR$="X")THEN FLAG(9)=0: GOTO 2790 ELSE FLAG(9)=1
  299. 2750 XC$=LEFT$(C$,2) : LEN.C = LEN(C$) - 2 : C$ = RIGHT$(C$,LEN.C)
  300. 2760 XX = VAL (XC$)
  301. 2770 'BUFFER$=BUFFER$ + CHR$(XX)
  302. 2780 RETURN
  303. 2790 PRINT "I don't recognize this print control character: ";CC.CHAR$
  304. 2800 RETURN
  305. 2810 '
  306. 2820 PITCH = 10
  307. 2830 IF FLAG(6) = 1 THEN PITCH = PITCH * 1.7
  308. 2840 IF FLAG(2) = 1 THEN PITCH = PITCH * .5
  309. 2850 RETURN
  310. 2860 '
  311. 2870 ' PAGENUMBER
  312. 2880 '
  313. 2890 P.END = 1
  314. 2900 FOR J = 2 TO 8: BUFFER$= BUFFER$ :NEXT J
  315. 2910 BUFFER$=BUFFER$ '+ ONN$(3)+ONN$(7)
  316. 2920 PN = LINE.LENGTH /2
  317. 2930 BUFFER$=BUFFER$ + SPACE$(PN)+ SECTION.C$ + " -" + STR$(PAGE)+SECT$
  318. 2940 GOSUB 2980
  319. 2950 BLANKS = 8: GOSUB 1400' PRINT BUFFER OUT AND EMPTY
  320. 2960 RETURN
  321. 2970 '
  322. 2980 ' Subroutine reset old cc.codes in new buffer
  323. 2990 '
  324. 3000 FOR K=2 TO 8
  325. 3010 '  IF FLAG(K) = 1 THEN BUFFER$ = BUFFER$ + ONN$(K)                                    ELSE BUFFER$ = BUFFER$ + OFFF$(K)
  326. 3020 NEXT K
  327. 3030 RETURN
  328. EN BUFFER$ = BUFFER$ + ONN$(K)